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-- BcdUtilities.Mesa Edited by Johnsson on April 13, 1978 7:54 AM 

DIRECTORY 

AltoDefs: FROM "altodefs", 
BcdControlDefs: FROM "bcdcontroldef s" , 
BcdDefs: FROM "bcddefs", 
BcdErrorDefs: FROM "bcderrordefs", 
BcdTabDefs: FROM "bcdtabdef s M , 
BcdTreeDefs: FROM "bcdtreedef s", 
BcdUtilDefs: FROM "bcdutildef s\ 
InlineDefs: FROM "inl inedef s" , 
StringDefs: FROM "stringdef s" , 
TableDefs: FROM "tabledefs" ; 

DEFINITIONS FROM BcdUtilDefs, BcdDefs; 

BcdUtilities: PROGRAM 

IMPORTS BcdErrorDefs, BcdTabDefs, StringDefs, TableDefs * 

EXPORTS BcdControlDefs, BcdUtilDefs - PUBLIC 

BEGIN 

STIndex: TYPE - BcdTabDefs. STIndex; 

STNull: STIndex - BcdTabDefs. STNull ; 

HTIndex: TYPE - BcdTabDefs .HTIndex; 

HTNull: HTIndex « BcdTabDefs. HTNull ; 

SubStringDescriptor : TYPE a StringDefs. SubStringDescriptor; 

Substring: TYPE « StringDefs .Substring; 

NullVersion: VersionStamp «- [ 

zapped: FALSE, net: 0, host: 0, time: [0,0]]; 

mtb, sgb, ftb, ctb, itb, etb, ntb, stb, cxb: TableDefs .TableBase; 

Notifier: PRIVATE TableDefs .TableNotif ier ■ 
BEGIN 

mtb *- base[mttype]; 

sgb «- base[sgtype]; 

ftb «- base[fttype]; 

ctb 4- basefcttype]; 

itb <- base[imptype]; 

etb ♦- base[exptype]; 

ntb ♦- base[nttype]; 

stb «- base[sttype]; 

cxb ♦- base[cxtype]; 
END; 

EnterName: PROCEDURE [ss: Substring] RETURNS [NameRecord] ■ 
BEGIN OPEN BcdTabDefs; 
Iss: SubStringDescriptor; 
hti: HTIndex * EnterString[ss]; 
SubStringForHash[@lss,hti]; 
RETURN[[lss. offset]]; 
END; 

MapName: PROCEDURE [bed: BcdBasePtr, n: NameRecord] RETURNS [NameRecord] ■ 
BEGIN 
ss: SubStringDescriptor «- 

[base: @bcd. ssb. string, offset: n, length: bcd.ssb.size[n]]; 
RETURN[EnterName[6ss]]; 
END; 

MapEquivalentName: PRIVATE PROCEDURE [bed: BcdBasePtr, n: NameRecord] RETURNS [NameRecord] 
BEGIN 
ss: SubStringDescriptor <- 

[base: ©bcd.ssb, string, offset: n, length: bcd.ssb.size[n]]; 
found: BOOLEAN; 
hti: HTIndex; 

[found, hti] <- BcdTabDefs. FindString[@ss]; 

IF -found THEN [found, hti] <- BcdTabDefs, FindEquivalentString[@ss]; 
RETURN[[IF found THEN NameForHti[hti] ELSE EnterName[@ss]]] 
END; 

HtiForName: PROCEDURE [bed: BcdBasePtr, n: NameRecord] RETURNS [HTIndex] - 
BEGIN 
ss: SubStringDescriptor <- 

[base: @bcd. ssb .string, offset: n, length: bcd.ssb. size[n]]; 
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RETURN[BcdTabDefs.EnterString[Qss]]; 
END; 

NameForHti: PROCEDURE [hti: BcdTabDefs.HTIndex] RETURNS [NameRecord] ■ 
BEGIN 

ss: SubStringDescriptor; 
BcdTabDefs.SubStringForHash[@ss, hti]; 
RETURN[[ss. offset]]; 
END; 

NameForSti: PROCEDURE [sti: BcdTabDef s.STIndex] RETURNS [NameRecord] ■ 
BEGIN 

RETURN[NameForHti[(stb+sti).hti]]; 
END; 

ContextForTree: PROCEDURE [t: BcdTreeDef s.TreeLink] 
RETURNS [BcdTabDefs.CXIndex] - 
BEGIN 

WITH t SELECT FROM 
symbol ■> 

WITH stb+index SELECT FROM 
local »> RETURN[context]; 
ENDCASE -> ERROR; 
ENDCASE ■> ERROR; 
END; 

EquivalentVersions: PROCEDURE [vl, v2: POINTER TO VersionStamp] 
RETURNS [BOOLEAN] « 
BEGIN 

RETURN[vl. zapped OR v2. zapped OR vlt - v2t] 
END; 

InsertFile: PROCEDURE [fn: NameRecord, version: POINTER TO VersionStamp] 
RETURNS [fti: FTIndex] * 
BEGIN 

ftLimit: FTIndex * LOOPHOLE[TableDef s.TableBounds[f ttype].size] ; 
mismatched: BOOLEAN «- FALSE; 
FOR fti ♦- FIRST[FTIndex], f ti+SIZE[FTRecord] 
UNTIL fti = ftLimit DO 
OPEN new: ftb+fti; 
IF new. name - fn THEN 
BEGIN 
SELECT TRUE FROM 

(new. version ■ NullVersion) ■> 

BEGIN new. version <- versiont; RETURN END; 
E qu i val en tVer si on s[@new. version, version], 
(versiont ■ NullVersion) «> 
BEGIN 

IF version. zapped THEN new. version. zapped «- TRUE; 
RETURN 
END; 
ENDCASE ■> mismatched <- TRUE; 
END; 
ENDLOOP; 
fti «- TableDefs.Allocate[fttype, SIZE[FTRecord]]; 
(ftb+fti)t ♦- [name: fn, version: versiont]; 
IF mismatched THEN 

BcdErrorDef s .ErrorFile[warning , "referenced in different versions", fti]; 
RETURN 
END; 

MergeFile: PROCEDURE [bcdL BcdBasePtr, oldfti: FTIndex] 
RETURNS [FTIndex] - 

BEGIN OPEN TableDefs, old: bed. f tb+oldf ti ; 
fn: NameRecord; 

IF oldfti - FTSelf OR oldfti - FTNull THEN RETURN[oldf ti]; 
fn <- MapEquivalentName[bcd, old. name]; 
RETURN[InsertFile[fn, @old. version]] 
END; 

EnterFile: PROCEDURE [name: STRING] 
RETURNS [FTIndex] ■ 
BEGIN OPEN TableDefs; 
ext: STRING <- [4]; 

ss: SubStringDescriptor <- [base: name, offset: 0, length: name. length]; 
fn: NameRecord; 
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found: BOOLEAN; 

hti: HTIndex; 

i: CARDINAL; 

IF ss.base[ss.offset+ss.length-l] ■ '. THEN 

ss. length <- ss.length-1; 
IF ss. length > 4 THEN 

BEGIN 

FOR i IN[0..4) DO 

ext[i] *- ss.base[ss.offset+ss. length-4+i]; 
ENDLOOP; 

ext. length «- 4; 

IF StringDefs.EquivalentString[ext, H .bcd M L] THEN 
ss. length «- ss.length-4; 

END; 
[found.hti] «- BcdTabDef s.FindString[@ss]; 

IF -found THEN [found.hti] «- BcdTabDef s. FindEquivalentString[@ss] ; 
fn ♦■ [IF found THEN NameForHti[hti] ELSE EnterName[0ss]]; 
RETURN[InsertFile[fn, ©Null Version]] 
END; 

SetFileVersion: PROCEDURE [fti: FTIndex, v: BcdDefs.VersionStamp] ■ 
BEGIN OPEN file: ftb+fti; 
SELECT TRUE FROM 

(file. version ■ NullVersion) ■> file. version «- v; 
EquivalentVersions[@f ile. version, 8v] ■> 

IF v. zapped THEN file. version. zapped <~ TRUE; 
ENDCASE »> 

BcdErrorDef s.ErrorFile[warning, "referenced in different versions'^, fti]; 
RETURN 
END; 

nextGfi: CARDINAL; 

GftOverflow: PUBLIC SIGNAL - CODE; 

GetGfi: PROCEDURE [n: CARDINAL] RETURNS [gfi: GFTIndex] ■ 
BEGIN 

gfi «- nextGfi; 
nextGfi «- nextGfi + n; 

IF nextGfi > LAST[GFTIndex] THEN ERROR GftOverflow; 
RETURN 
END; 

nextDummyGf i : CARDINAL; 

GetDummyGfi: PROCEDURE [n: CARDINAL] RETURNS [gfi: CARDINAL] - 
BEGIN 

gfi <- nextDummyGf i ; 
nextDummyGf i «- nextDummyGf i + n; 
RETURN 
END; 

NewContext: PROCEDURE RETURNS [cxi: BcdTabDef s .CXIndex] - 
BEGIN 

cxi <- TableDefs.Allocate[cxtype, SIZE[BcdTabDefs.CXRecord]]; 
(cxb+cxi)t 4- [link: STNull]; 
RETURN 
END; 

NewSemanticEntry: PROCEDURE [hti; HTIndex] 
RETURNS [sti: BcdTabDef s .STIndex] » 
BEGIN 

sti <- TableDefs.Allocate[sttype, SIZE[BcdTabDef s.STRecord]]; 
(stb+sti)t <- [ 

filename: FALSE, 

assigned: FALSE, 

imported: FALSE, 

exported: FALSE, 

hti: BcdTabDefs.HTNull, 

link: BcdTabDef s. STNull , 

impi: IMPNull, 

impgfi: 0, 

body: unknown[]]; 
(stb+sti).hti ♦• hti; 
RETURN 
END; 
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EnterModule: PROCEDURE [bed: BcdBasePtr, oldmti: MTIndex, name: HTIndex] 
RETURNS [mt1: MTIndex] - 
BEGIN OPEN old: bcd.mtb+oldmti ; 
size: CARDINAL - SIZE[MTRecord]+old. frame, length; 
mti <- TableDefs.Allocate[mttype, size]; 
InlineDefs.COPY[to: mtb+mti t from: Gold, nwords: size]; 
(mtb+mti) .name <- MapName[bcd, (mtb+mti) .name]; 
IF name # HTNull THEN 

BEGIN 

(mtb+mti) .namedinstance «- TRUE; 

CreateInstanceName[name, [module[mti]]]; 

END 
ELSE IF (mtb+mti). namedinstance THEN 

BEGIN 

CopyInstanceName[bcd, [module[oldmti]], [module[mti]]]; 

END; 
RETURN 
END; 

EnterSegment: PROCEDURE [seg: SGRecord] 
RETURNS [sgi: SGIndex] ■ 
BEGIN 

sgLimit: SGIndex ■ LOOPHOLE[TableDef s .TableBounds[sgtype] .size] ; 
FOR sgi <- FIRST[SGIndex], sgi+SIZE[SGRecord] 
UNTIL sgi ■ sgLimit DO 

IF (sgb+sgi)t - seg THEN RETURN; 

ENDLOOP; 
sgi <- TableDefs.Allocate[sgtype, SIZE[SGRecord]]; 
(sgb+sgi)t «- seg; 
RETURN 
END; 

Enterlmport: PROCEDURE [bed: BcdBasePtr, olditi: IMPIndex, name: HTIndex] 
RETURNS [iti: IMPIndex] « 
BEGIN OPEN old: bed. itb+olditi ; 

iti «- TableDefs.Allocate[imptype, SIZE[IMPRecord]]; 
(itb+iti)+ «- old; 

(itb+iti) .name «- MapName[bcd, old. name]; 
IF name # HTNull THEN 

BEGIN 

(itb+iti) .namedinstance «- TRUE; 

Create In stanceName[ name, [import[iti]]]; 

END 
ELSE IF (itb+iti). namedinstance THEN 

BEGIN 

CopyInstanceName[bcd, [import[olditi]], [import[iti]]]; 

END; 
RETURN 
END; 

EnterExport: PROCEDURE [bed: BcdBasePtr, oldeti: EXPIndex, name: HTIndex] 
RETURNS [eti: EXPIndex] ■ 

BEGIN OPEN new: etb+eti, old: bcd.etb+oldeti ; 
i, size: CARDINAL; 
size *- old.size+SIZE[EXPRecord]; 
eti «- TableDef s .Allocate[exptype, size]; 
new ♦- old; 
FOR i IN [0. .new. size) DO 

new. 1 inks[i] <- NullLink; 

ENDLOOP; 
new. name <- MapName[bcd, old. name]; 
IF name # HTNull THEN 

BEGIN 

(etb+eti) .namedinstance <- TRUE; 

CreateInstanceName[name, [export[eti]]]; 

END 
ELSE IF (etb+eti) .namedinstance THEN 

BEGIN 

CopyInstanceName[bcd, [export[oldeti]], [export[eti]]] ; 

END; 
RETURN 
END; 

EnterConfig: PROCEDURE [bed: BcdBasePtr, oldeti: CTIndex, name: HTIndex] 
RETURNS [eti: CTIndex] - 
BEGIN OPEN old: bed. ctb+oldcti ; 
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cti <- TableDefs.Allocate[cttype, SIZE[CTRecord]]; 

(ctb+cti)t ♦- old; 

(ctb+cti) .name <- MapName[bcd, old. name]; 

IF name # HTNull THEN 

BEGIN 

(ctb+cti) .namedinstance <- TRUE; 

CreateInstanceName[name, [conf ig[cti]]]; 

END 
ELSE IF (ctb+cti). namedinstance THEN 

BEGIN 

CopyInstanceName[bcd, [conf ig[oldcti]], [conf ig[cti]]]; 

END; 
RETURN 
END; 

CreatelnstanceName: PROCEDURE [hti: HTIndex, item: Namee] ■ 
BEGIN 

nti: NTIndex <- TableDefs.Allocate[nttype, SIZE[NTRecord]]; 
(ntb+nti) . item «- item; 
(ntb+nti) .name <- NameForHti[hti]; 
RETURN 
END; 

CopylnstanceName: PRIVATE PROCEDURE [bed: BcdBasePtr, old, new: Namee] 
BEGIN 

nti: NTIndex ♦■ TableDefs.Al locate[nttype, SIZE[NTRecord]]; 
oldnti: NTIndex; 
(ntb+nti) . item «- new; 

FOR oldnti <- FIRST[NTIndex] , oldnti+SIZE[NTRecord] DO 
IF (bed. ntb+oldnti). item ■ old THEN EXIT; 
ENDLOOP; 
(ntb+nti) .name <- MapName[bcd, (bed. ntb+oldnti) .name]; 
RETURN 
END; 

-- timing procedures 

timer: PRIVATE POINTER TO CARDINAL ■ LOOPHOLE[430B]; 

TimeNow: PROCEDURE RETURNS [CARDINAL] ■ 
BEGIN 

RETURN[timert] 
END; 

TimeSince: PROCEDURE [start: CARDINAL] RETURNS [CARDINAL] - 
BEGIN OPEN InlineDefs; 

RETURN[(LongDiv[LongMult[timert-s tart, 2*39], 1000]+l)/2] 
END; 

-- Administrative Procedures 

InitUtilities: PROCEDURE - 
BEGIN 

TableDefs.AddNotify[Notifier]; 
nextGfi <- nextDummyGfi ♦■ 1; 
END; 

EraseUtilities: PROCEDURE - 
BEGIN 

TableDef s .DropNotify[Notif ier]; 
END; 

END. 



